home *** CD-ROM | disk | FTP | other *** search
/ Collection of Tools & Utilities / Collection of Tools and Utilities.iso / pascal / totsrc11.zip / EXTIO3.PAS < prev    next >
Pascal/Delphi Source File  |  1993-05-04  |  10KB  |  362 lines
  1. {               Copyright 1991 TechnoJock Software, Inc.               }
  2. {                          All Rights Reserved                         }
  3. {                         Restricted by License                        }
  4.  
  5. {                             Build # 1.01                             }
  6.  
  7. {                     Adds DropListIOOBJ  Objects                      }
  8.  
  9. Unit ExtIO3;
  10. {$I TOTFLAGS.INC}
  11. {
  12.  Development Notes:   6/23/92  1.01  Overhauled input routines to
  13.                                      function in a WinFormOBJ, and
  14.                                      to handle the Esc key.
  15. }
  16.  
  17. INTERFACE
  18.  
  19. uses DOS, CRT, 
  20.      totFAST, totWIN, totIO1, totIO2, totSTR, totInput, totLINK;
  21.  
  22. TYPE
  23.  
  24. DropListIOOBJ = object (ListIOOBJ)
  25.    vWin: pWinOBJ;
  26.    vLastPick: word;
  27.    {methods ...}
  28.    constructor Init(X1,Y1,width,depth:byte);
  29.    procedure   Drop;
  30.    procedure   MonoDraw(Attr:byte);
  31.    function    Select(K:word; X,Y:byte):TAction;            VIRTUAL;
  32.    function    OnTarget(X,Y: byte):boolean;                 VIRTUAL;
  33.    function    ProcessKey(InKey:word;X,Y:byte):tAction;     VIRTUAL;
  34.    procedure   Display(Status:tStatus);                     VIRTUAL;
  35.    function    Suspend:boolean;                             VIRTUAL;
  36.    destructor  Done;                                        VIRTUAL;
  37. end; {DropListIOOBJ}
  38.  
  39. pDropArrayIOOBJ = ^DropArrayIOOBJ;
  40. DropArrayIOOBJ = object (DropListIOOBJ)
  41.    vArrayPtr: pointer;
  42.    vStrLength: byte;
  43.    {methods ...}
  44.    constructor Init(X1,Y1,width,depth:byte);
  45.    procedure   AssignList(var StrArray; Total:Longint; StrLength:byte);
  46.    function    GetString(Pick:integer): string;             VIRTUAL;
  47.    destructor  Done;                                        VIRTUAL;
  48. end; {DropArrayIOOBJ}
  49.  
  50. pDropLinkIOOBJ = ^DropLinkIOOBJ;
  51. DropLinkIOOBJ = object (DropListIOOBJ)
  52.    vLinkList: ^DLLOBJ;
  53.    {methods ...}
  54.    constructor Init(X1,Y1,width,depth:byte);
  55.    procedure   AssignList(var LinkList: DLLOBJ);
  56.    function    GetString(Pick:integer): string;             VIRTUAL;
  57.    destructor  Done;                                        VIRTUAL;
  58. end; {DropLinkIOOBJ}
  59.  
  60.  
  61. IMPLEMENTATION
  62. constructor DropListIOOBJ.Init(X1,Y1,width,depth:byte);
  63. {}
  64. begin
  65.    ListIOOBJ.Init(X1,Y1,width,depth,'');
  66.    vWin := nil;
  67. end; {DropListIOOBJ.Init}
  68.  
  69. function DropListIOOBJ.OnTarget(X,Y: byte):boolean;
  70. {}
  71. begin
  72.    with vBoundary do
  73.    if vWin = nil then
  74.       OnTarget := (Y = Y1) and ListIOOBJ.OnTarget(X,Y)
  75.    else
  76.       Ontarget := (X >= pred(X1)) and (X <= succ(X2)) and (Y >= pred(Y1)) and (Y <= succ(Y2));
  77. end; {DropListIOOBJ.OnTarget}
  78.  
  79. function DropListIOOBJ.ProcessKey(InKey:word;X,Y:byte):tAction;  
  80. {}
  81. begin
  82.    ProcessKey := None;
  83.    if vWin = nil then {window not down}
  84.    begin
  85.       case InKey of
  86.          336: Drop;
  87.          513,523: if (Y = vBoundary.Y1) 
  88.          and ((X >= vBoundary.X2-2) and (X <= vBoundary.X2)) then
  89.             Drop;
  90.          328,331: if pred(vTopPick)+vActivePick > 1 then
  91.          begin
  92.             if vTopPick > 1 then
  93.                dec(vTopPick)
  94.             else
  95.                dec(vActivePick);
  96.             MonoDraw(IOTOT^.FieldCol(2));
  97.          end;
  98.          32,333: if pred(vTopPick)+vActivePick < vTotPicks then
  99.          begin
  100.             if vActivePick < vRows then
  101.                inc(vActivePick)
  102.             else
  103.                inc(vTopPick);
  104.             MonoDraw(IOTOT^.FieldCol(2));
  105.          end;
  106.       end; {case}
  107.    end;
  108. (*
  109.    else
  110.    begin
  111.       if  (((InKey = 513) or (Inkey = 523)) 
  112.            and (Y = pred(vBoundary.Y1))
  113.            and (X = vBoundary.X1+2))
  114.       or  (InKey = 13)
  115.       then
  116.       begin
  117.          dispose(vWin,Done);
  118.          vWin := nil;
  119.          MonoDraw(IOTOT^.FieldCol(2));
  120.       end
  121.       else
  122.          Processkey := ListIOOBJ.ProcessKey(InKey,X,Y);
  123.    end;
  124. *)
  125. end; {DropListIOOBJ.ProcessKey}
  126.  
  127. procedure DropListIOOBJ.Drop;
  128. {}
  129. var
  130.    DK,DX,DY:word;
  131.    Finished:boolean;
  132.    Temp: TAction;
  133.  
  134.     procedure RemoveDropListWin;
  135.     {}
  136.     begin
  137.        dispose(vWin,Done);
  138.        vWin := nil;
  139.        MonoDraw(IOTOT^.FieldCol(2));
  140.     end;
  141.  
  142. begin
  143.    new(vWin,Init);
  144.    with vBoundary do
  145.    with vWin^ do
  146.    begin
  147.       SetSize(pred(X1),pred(Y1),succ(X2),succ(Y2),1);
  148.       SetWinRestrict(false);
  149.       SetColors(IOTOT^.FieldCol(1),0,0,IOTOT^.FieldCol(1));
  150.       Draw;
  151.       ListIOOBJ.Display(HiStatus);
  152.    end;
  153.    {now process all keystrokes locally until user clicks
  154.     away from the list}
  155.    Finished := false;
  156.    vLastPick := vActivePick;
  157.    delay(250);
  158.    repeat
  159.       Key.GetInput;
  160.       DK := Key.LastKey;
  161.       DX := Key.LastX;
  162.       DY := Key.LastY;
  163.       if  (((DK = 513) or (DK = 523))
  164.           and (DY = pred(vBoundary.Y1))
  165.           and (DX = vBoundary.X1+2))
  166.       or  (DK = 13)
  167.       then
  168.       begin
  169.          RemoveDropListWin;
  170.          Finished := true;
  171.       end
  172.       else if (DK = 27) then
  173.       begin
  174.          vActivePick := vLastPick;
  175.          RemoveDropListWin;
  176.          Finished := true;
  177.       end
  178.       else if ((DK = 513) or (DK = 523))
  179.            and (
  180.                     (DY < pred(vBoundary.Y1))
  181.                  or (DY > succ(vBoundary.Y2))
  182.                  or (DX < pred(vBoundary.X1))
  183.                  or (DX > succ(vBoundary.X2))
  184.               )
  185.       then
  186.       begin
  187.          vActivePick := vLastPick;
  188.          RemoveDropListWin;
  189.          Finished := true;
  190.          (*
  191.          Key.StuffBuffer(DK);
  192.          *)
  193.       end
  194.       else
  195.          Temp := ListIOOBJ.ProcessKey(DK,DX,DY);
  196.    until Finished;
  197. end; {DropListIOOBJ.Drop}
  198.  
  199. function DropListIOOBJ.Select(K:word; X,Y:byte):TAction;
  200. {}
  201. begin
  202.    vScrollBarOn := (vTotPicks >= vRows);
  203.    vActiveField := true;
  204.    Display(HiStatus);
  205.    WriteLabel(HiStatus);
  206.    WriteMessage;
  207.    if ((K = 513) or (K=523)) 
  208.    and (Y = vBoundary.Y1) 
  209.    and ((X >= vBoundary.X2-2) and (X <= vBoundary.X2)) then {landed on down arrow}
  210.       Drop;
  211.    Select := none;
  212. end; {DropListIOOBJ.Select}
  213.  
  214. procedure DropListIOOBJ.MonoDraw(Attr:byte);
  215. {}
  216. var Str :string;
  217. begin
  218.    if vListAssigned then
  219.       with vBoundary do
  220.       begin
  221.          Str := padleft(GetString(GetValue),X2-X1-2,' ');
  222.          Screen.WriteAt(X1,Y1,Attr,Str);
  223.          GotoXY(X1,Y1);
  224.       end;
  225. end; {DropListIOOBJ.MonoDraw}
  226.  
  227. procedure DropListIOOBJ.Display(Status:tStatus);                  
  228. {}
  229. var
  230.   Attr: byte;
  231.   BackAttr: byte;
  232. begin
  233.    if vWin = nil then
  234.    begin
  235.       if vListAssigned then
  236.       begin
  237.          case Status of
  238.          HiStatus:    Attr := IOTOT^.FieldCol(2);
  239.          Norm:  Attr := IOTOT^.FieldCol(1);
  240.          Off:   Attr := IOTOT^.FieldCol(4);
  241.          end; {case}
  242.          with vBoundary do
  243.          begin
  244.             MonoDraw(Attr);
  245.             BackAttr := BAttr(Screen.ReadAttr(X2-2,Y1));
  246.             Screen.WriteAt(X2-2,Y1,Cattr(BAttr(Attr),Backattr),'▐ ▌');
  247.             Screen.WriteAt(pred(X2),Y1,Attr,'');
  248.          end;
  249.       end;
  250.    end
  251.    else
  252.       ListIOOBJ.Display(Status);
  253. end; {DropListIOOBJ.Display}
  254.  
  255. function DropListIOOBJ.Suspend:boolean;                          
  256. {}
  257. begin
  258.    if vWin <> nil then
  259.    begin
  260.       dispose(vWin,Done);
  261.       vWin := nil;
  262.    end;
  263.    Display(Norm);
  264.    Suspend := ListIOOBJ.Suspend;
  265. end; {DropListIOOBJ.Suspend}
  266.  
  267. destructor DropListIOOBJ.Done;                                     
  268. {}
  269. begin
  270.    ListIOOBJ.Done;
  271. end; {DropListIOOBJ.Done}
  272. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  273. {                                                    }
  274. {     D r o p A r r a y I O O B J   M E T H O D S    }
  275. {                                                    }
  276. {||||||||||||||||||||||||||||||||||||||||||||||||||||}
  277. constructor DropArrayIOOBJ.Init(X1,Y1,width,depth:byte);
  278. {}
  279. begin
  280.    DropListIOOBJ.Init(X1,Y1,width,depth);
  281. end; {DropArrayIOOBJ.Init}
  282.  
  283. procedure DropArrayIOOBJ.AssignList(var StrArray; Total:Longint; StrLength:byte);
  284. {}
  285. begin
  286.    vArrayPtr := @StrArray;
  287.    vStrLength := StrLength;
  288.    vTotPicks := Total;
  289.    vListAssigned := true;
  290. end; {DropArrayIOOBJ.AssignList}
  291.  
  292. function DropArrayIOOBJ.GetString